perm filename DVIPRE.SAI[TEX,ALS] blob
sn#580820 filedate 1981-04-29 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 begin "DVIPRE"
C00007 00003 Definitions and data structures for the .DVI file
C00010 00004 Macro definitions and data structures for fonts
C00014 00005 Routines for time of day and file information (highly system-dependent)
C00018 00006 error, overflow, scanfilename, getnext, getint
C00022 00007 Output routines
C00028 00008 Definitions and data structures for PRE file
C00039 00009 General description of the shipout procedure.
C00042 00010 readfontinfo
C00062 00011 findpostamble, getfontnames
C00069 00012 getfiles
C00072 00013 The recursive procedure nestout
C00084 00014 procedure pageout # the main output procedure,produces one page
C00088 00015 procedure closeout # just before TEX stops, do this
C00092 00016 Main routine
C00094 ENDMK
C⊗;
begin "DVIPRE"
comment First Written: Feb 1 1981. (IAZ)
Last Update: Feb 27 1981 (IAZ)
This program converts a .DVI file into a .PRE file.
It was written by Ignacio Zabala, with the original purpose of being able
to obtain printed output for the TEX-PASCAL program, which generates
DVI files in the style of those generated by the TEXPRS output module of
TEX.
The code is based on that of TEXPRS.SAI, written by D. E. Knuth, and on the
old DVIXGP.SAI program.
D. R. Fuchs designed the format of DVI files. It is documented in
DVIINF.TEX[1,DRF] and <TEX.PASCAL>DVIINF.TEX % SCORE.
This routine is designed for output to the Xerox Dover Printer
at Stanford.;
require 750 system_pdl; comment our stack is a parasite of SAIL's stack;
comment Some syntactic sugar;
require "{}{}" delimiters;
define # = {;comment },
loop = { while true do },
thru = { ←1 step 1 until },
upto = { step 1 until },
downto = { step -1 until },
nextline = {'15&'12},
tab = {'11&null},
saf = { safe },
simp = { simple },
bitsperwd = 36;
label end_of_dvipre # go here to quit;
comment Variables for file references;
saf string array fname[0:4] # components of a file name;
integer brchar, eof # parameters for opening files;
define DEBUGONLY = { comment } # { } when debugging ;
DEBUGONLY string indent # to display nesting level;
DEBUGONLY integer DEBUG # says kind of debugging;
DEBUGONLY define precommands = 1,
dvicommands = 2,
dvibytes = 4,
iooperations = 8;
comment Simple debugging will only show location of postamble, page dimensions
and font names. But any additional information can be obtained setting
DEBUG adecuately;
DEBUGONLY redefine saf = {},
simp = {};
define micasPerRSU={0.01};
define micasPerInch={2540};
define inchesPerPoint={0.013837};
define rsusPerPoint={3514.598};
define pointsPerInch={(1/inchesPerPoint)};
comment Definitions for access to fields of words;
define fs(f) = {f}&"s" # field size of f, in bits;
define fd(f) = {f}&"d" # field displacement of f, in bits;
define field(f,x) = {ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc} # field f of x;
define flag = {(1 rot -1)} # to mark used characters;
integer foo # for real to integer conversions;
comment Definitions and data structures for the .DVI file;
comment The DVI commands;
define NOP={128}, BOP={129}, EOP={130}, PST={131},
DVIPUSH={132}, DVIPOP={133},
VERTRULE={134}, HORZRULE={135}, HORZCHAR={136}, DVIFONT={137},
W4={138}, W3={139}, W2={140}, W0={141},
X4={142}, X3={143}, X2={144}, X0={145},
Y4={146}, Y3={147}, Y2={148}, Y0={149},
Z4={150}, Z3={151}, Z2={152}, Z0={153},
FONTNUM={154} # to 217;
integer dviword # a word form the .DVI file;
integer curdvibyte # the last byte read from the .DVI file;
saf integer array texcounter["0":"9"] # contents of TEX counters at beginning of page;
integer curpage # current page being processed;
integer curfont # used to access fontinfo and fmem;
integer dvibytecnt # number of seen bytes;
integer dvirecnum # a logical record number;
integer postambleptr # byte number of first byte in the postamble;
integer lastpageptr # byte number of BOP command for previous page;
integer magnification # all values in the file should be multiplied by this quantity;
real unitscale # ratio of rsu's (10↑(-7) meters) to units in dvi file;
real printunits # ratio of whatever any desired units to rsus;
real micastoprint # ratio of display units to micas (printunits/micasPerRSU);
real dvitoprint # ratio of display units to internal dvi units (unitscale*printunits);
string dvifile # name of the file;
integer dvichan # channel number;
comment Macro definitions and data structures for fonts;
define nfonts=64 # number of fonts allowed (must be power of two);
define fmemsize=8000 # size of font memory for secondary tables;
saf integer array fmem[0:fmemsize-1] # font memory for secondary font info;
define fmemreal(k)={memory[location(fmem[k]),real]};
integer fmemptr # first unused location in fmem;
comment the 7-bit char assumption is too deeply built in!;
saf integer array fontinfo[0:128*nfonts-1] # primary font info table;
saf integer array wdbase,htbase,dpbase,icbase,lgbase,krbase,
extbase, parbase[0:nfonts-1] # base addresses in fmem for
secondary font tables;
saf string array fontname[0:nfonts-1] # font file names;
saf integer array fcksum[0:nfonts-1];
saf integer array fmag[0:nfonts-1] # font ``at'' values (relative to font design size) times 1000;
saf integer array fsize[0:nfonts-1] # font ``at'' values absolute, in rsu's;
saf integer array fpfi[0:nfonts-1,1:5];
saf integer array fpfb[0:nfonts-1];
saf boolean array fontused[0:nfonts-1] # any character from the font is printed?;
define rmd=4,rms=8,tgd=12,tgs=2,icd=14,ics=6,dpd=20,dps=4,
htd=24,hts=4,wdd=28,wds=8;
define tagnone=0, taglig=1,taglist=2,tagvar=3;
define charwd(f,t)={fmemreal(wdbase[f]+field(wd,t))}
# width in font f, fontinfo t;
define charht(f,t)={fmemreal(htbase[f]+field(ht,t))}
# height in font f, fontinfo t;
define chardp(f,t)={fmemreal(dpbase[f]+field(dp,t))}
# depth in font f, fontinfo t;
define ligstep=0,kernstep=1;
define nextchar(x)={(x lsh -20) land '377};
define tagbit(x)={(x lsh -19) land 1};
define remainder(x)={(x lsh -4) land '377};
define lhalf(x)={(x lsh -20) land '177777};
define rhalf(x)={(x lsh -4) land '177777};
comment Routines for time of day and file information (highly system-dependent);
integer octaltime # the machine's one word date/time stamp, in whatever
format the OS specifies;
comment These routines are due to Hans Moravec;
string procedure daytime;
begin comment returns octaltime down to the second, as a string;
integer d,t,sw,sd; string s;
string procedure cvs2(integer i);
return((((i div 10) mod 10)+"0")&((i mod 10)+"0"));
t←octaltime land '777777; d←octaltime lsh -18;
getformat(sw,sd); setformat(0,7);
s←cvs((d mod 31)+1)&", "&cvs((d div 31)div 12 + 1964);
setformat(sw,sd);
return((case ((d div 31) mod 12) of
("January","February","March","April","May","June",
"July","August","September","October","November","December"))&" "&
s&" "&cvs2(t div (60*60))&":"&
cvs2((t div 60) mod 60)&":"&cvs2(t mod 60));
end;
comment Press file format demands that we supply a machine date/time
stamp in Alto-Pup format, and the user's name as a string;
integer procedure altotime;
comment Returns the number of seconds since midnight, Jan. 1, 1901 GMT;
begin integer stdtime # seconds since midnight, Pacific standard time;
integer days # days since Jan. 1, 1964;
stdtime←call(0,"STDTIM") land '777777;
days←call(0,"DAYCNT");
return(((23010+days)*24+8)*3600+stdtime);
end;
string procedure username;
comment Returns the name of the logged-in user as a SAIL string;
begin string prg, name, nxtprg, nxtnam;
integer namfil, brchar, eof, lftabbreak, ppn, i, j;
ppn←call(0,"GETPPN") # ppn is in 6-bit format;
prg←"" # null characters in prg would hurt, so can't use CVXSTR;
for i←-12 step 6 until 0 do if (j←(ppn lsh i) land '77) then prg←prg&(j+'40);
setbreak(lftabbreak←getbreak,'12&'11,'15&'15,"ISN");
open(namfil←getchan,"DSK",0,2,0,150,brchar,eof);
lookup(namfil,"FACT.TXT[SPL,SYS]", eof);
name←prg&" @ SAIL" # this is used for new accounts not yet in the FACT file;
brchar←'12; comment we don't need to check brchar below if FACT is good;
while not eof do
begin if brchar='12 then nxtprg←input(namfil,lftabbreak);
if brchar='11 then nxtnam←input(namfil,lftabbreak);
if equ(prg,nxtprg) then
begin name←nxtnam; done;
end;
end;
release(namfil);
relbreak(lftabbreak);
return(name);
end;
comment error, overflow, scanfilename, getnext, getint;
procedure error(string s);
begin
print(nextline,"!"&s&".");
goto end_of_dvipre;
end;
define overflow(s)=
{ error("Table capacity exceeded, sorry ["&"s"&"="&cvs(s)&"]") };
define warn(s)=
{ print(nextline,"WARNING: "& s &".") };
procedure scanfilename(string fns) # decomposes fns into name, ext and dir which
which go in fname[0], fname[1] and fname[2]. Device names and DEC-20 style
directory names will ignored (but are saved, we might want to use them later on);
begin integer j # indicates current part of file name (0: name, 1: ext, 2: dir);
integer c # an ascii character code;
fname[0]←fname[1]←fname[2]←null; j←0;
while fns do
begin if (c←lop(fns))="." and j=0 then j←1
else if c="[" then j←2
else if c="<" then j←3
else if c=">" then begin fname[j]←fname[j]&c; j←0;
continue
end
else if c=":" then begin fname[4]←fname[0]&c;
fname[0]←null; j←0; continue
end;
fname[j]←fname[j]&c
end
end;
integer procedure getnext # returns the next 8-bit byte from the .DVI file;
begin
if (dvibytecnt land 3)=0 then dviword←wordin(dvichan) # get new word;
dviword←dviword rot 8 # put next byte in lowest positions;
dvibytecnt←dvibytecnt+1 # this is the number of the byte to be accessed next;
DEBUGONLY if (DEBUG land dvibytes) then print(nextline,"DVIBCNT=",dvibytecnt,
" '",cvos(dviword land '377),"=",(dviword land '377));
return(dviword land '377)
end;
define bites2 = {((getnext lsh 8) lor getnext)},
bites3 = {((bites2 lsh 8) lor getnext)},
bites4 = {((bites3 lsh 8) lor getnext)};
define twobites = {((bites2 lsh 20) ash -20)},
threebites = {((bites3 lsh 12) ash -12)},
fourbites = {((bites4 lsh 4) ash -4)};
comment thus, a bite will fetch you some fresh bits (two,three and fourbites
give the equivalent in rsu's);
integer procedure getint; return((bites4 lsh 4) ash -4);
comment Output routines;
define maxparts=400;
saf integer array partdir[0:2*maxparts];
integer pdptr, nparts # byte pointer into partdir, number of parts;
define conv={((magnification/1000)*micasPerRSU*unitscale)};
define inches(n)={((micasPerInch*(n)+.14159)/conv)};
define roundup(x)={(conv*(x)+.999999)} # integer←roundup(x) gives ceiling(x);
define pageheight={(11*micasPerInch)}, pagewidth={(8.5*micasPerInch)};
comment Next we have some procedures to implement byte-oriented I/O
using SAIL's I/O primitives;
string prefile # names of file;
integer prechan # channel number;
integer prerecnum # current record number in output;
integer nextword # holds bytes that form part of the next word to be output;
integer prebytecnt # number of bytes already output on prechan;
simp procedure Bout(integer byte);
begin comment output an 8-bit byte to prechan;
case (prebytecnt mod 4) of
begin
[0] nextword←byte lsh 28;
[1] nextword←nextword lor ((byte land '377) lsh 20);
[2] nextword←nextword lor ((byte land '377) lsh 12);
[3] wordout(prechan, nextword lor ((byte land '377) lsh 4));
else
end;
prebytecnt←prebytecnt+1;
end;
simp procedure Wout(integer word);
begin comment output a 16-bit word to prechan;
case (prebytecnt mod 4) of
begin
[0] nextword←word lsh 20;
[2] wordout(prechan,nextword lor ((word land '177777) lsh 4));
else
begin
print(nextline,"! Wout argument must be at 16-bit boundary.");
goto end_of_dvipre;
end
end;
prebytecnt←prebytecnt+2;
end;
simp procedure Dout(integer word);
begin
Wout(word lsh -16); Wout(word);
end;
simp procedure DoutAligned(integer word);
begin comment Hacked version of Dout: file must be at a double
word boundary, and the argument word is NOT shifted;
DEBUGONLY if (prebytecnt mod 4)≠0 then
DEBUGONLY begin
DEBUGONLY print(nextline,"! DoutAligned arg must begin at double word boundary.");
DEBUGONLY goto end_of_dvipre;
DEBUGONLY end;
wordout(prechan,word);
prebytecnt←prebytecnt+4;
end;
simp procedure Sout(reference integer first; integer numbytes);
begin comment output a string of 8-bit bytes: the output file
must start out and end 32-bit-word aligned!;
integer numwords;
DEBUGONLY if (prebytecnt mod 4)≠0 then
DEBUGONLY begin
DEBUGONLY print(nextline,"! Sout arg must begin at double word boundary.");
DEBUGONLY goto end_of_dvipre;
DEBUGONLY end;
DEBUGONLY if (numbytes mod 4)≠0 then
DEBUGONLY begin
DEBUGONLY print(nextline,"! Sout arg must be 32-bit aligned.");
DEBUGONLY goto end_of_dvipre;
DEBUGONLY end;
numwords←numbytes div 4;
arryout(prechan,first,numwords);
prebytecnt←prebytecnt+numbytes;
end;
simp integer procedure PadRecord(integer padval);
begin
integer padlength, i, paddingword;
padlength←-(prebytecnt mod 512);
if padlength<0 then padlength←padlength+512;
for i←1 upto (padlength mod 4) do Bout(padval);
paddingword←(padval lsh 8) lor padval;
paddingword←(paddingword lsh 16) lor paddingword;
paddingword←paddingword lsh 4;
for i←1 upto (padlength div 4) do DoutAligned(paddingword);
return(padlength);
end;
simp procedure iBCPLout(integer findex; integer maxbytes);
begin integer i,bp;
bp←point(8,fpfi[findex,1],-1);
for i←0 upto maxbytes-1 do Bout(ildb(bp));
end;
simp procedure sBCPLout(string s; integer maxbytes);
begin
integer len, i;
len←(maxbytes-1) min length(s);
Bout(len);
for i←1 upto maxbytes-1 do
if i<=len then Bout(s[i to i]) else Bout(0);
end;
comment Definitions and data structures for PRE file;
comment Press Entity list commands;
define
ELShowCharactersShort = '0,
ELSetSpaceXShort = '140,
ELFont = '160,
ELSetX = '356,
ELSetY = '357,
ELShowCharacters = '360,
ELSetSpaceX = '364,
ELResetSpace = '366,
ELShowRectangle = '376,
ELNop = '377,
ELSkipCharactersShort = '40,
ELSetBrightness = '370,
ELSetHue = '371,
ELSetSaturation = '372;
comment our Press file will have four entities per page: at sixteen
fonts per entity (one font set), this allows up to 64 fontsa;
short integer en # current entity (0,1,2, or 3);
define d0max=8000, e0max=12000, d1max=8000, e1max=12000;
define d2max=8000, e2max=12000, d3max=8000, e3max=12000;
define d0len=d0max div 4, d1len=d1max div 4;
define d2len=d2max div 4, d3len=d3max div 4;
define e0len=e0max div 4, e1len=e1max div 4;
define e2len=e2max div 4, e3len=e3max div 4;
saf integer array dl0[0:d0len];
saf integer array el0[0:e0len];
saf integer array dl1[0:d1len];
saf integer array el1[0:e1len];
saf integer array dl2[0:d2len];
saf integer array el2[0:e2len];
saf integer array dl3[0:d3len];
saf integer array el3[0:e3len];
saf integer array dlp[0:3] # data list pointers;
saf integer array elp[0:3] # entity list pointers;
preload_with d0max,d1max,d2max,d3max;
saf integer array dmax[0:3] # max permissible data list count (bytes);
preload_with e0max,e1max,e2max,e3max;
saf integer array emax[0:3] # max permissible entity list count (bytes);
DEBUGONLY integer array dlmaxused[0:3] # max attained data list count (bytes);
DEBUGONLY integer array elmaxused[0:3] # max attained entity list count (bytes);
saf integer array dct[0:3] # current data list count (bytes);
saf integer array ect[0:3] # current entity list count (bytes);
saf integer array lsc[0:3] # data list count of previous ShowChars;
saf integer array cx[0:3] # current x position;
saf integer array cy[0:3] # current y position;
saf integer array cf[0:3] # current font;
ifc nfonts≠64 thenc
require "TexPrs currently assumes that nfonts is 64:" message;
require " 4 entities with one font set (= 16 fonts) for each!" message;
endc
define fontset(f)={(f land '3)} # right-most two bits are font set;
define fontno(f)={(f lsh -2)} # the other four bits are font within set;
comment Procedures for dealing with DL and EL;
simp procedure StartPage;
begin
integer i;
comment initialize byte pointers into DL and EL;
dlp[0]←point(8, dl0[0], -1);
dlp[1]←point(8, dl1[0], -1);
dlp[2]←point(8, dl2[0], -1);
dlp[3]←point(8, dl3[0], -1);
elp[0]←point(8, el0[0], -1);
elp[1]←point(8, el1[0], -1);
elp[2]←point(8, el2[0], -1);
elp[3]←point(8, el3[0], -1);
for i←0 step 1 until 3 do
begin dct[i]←0; ect[i]←0; lsc[i]←0; cx[i]←0; cy[i]←0; cf[i]←-1;
end;
en←0;
end;
simp procedure ELByte (integer b);
begin
if ect[en]≥emax[en] then overflow(emax[en]);
idpb(b, elp[en]);
ect[en]←ect[en]+1;
end;
simp procedure ELWord (integer w);
begin ELByte(w lsh -8); ELByte(w) end;
simp procedure ELDWord (integer d);
begin ELWord(d lsh -16); ELWord(d) end;
simp procedure DLByte (integer b);
begin
if dct[en]≥dmax[en] then overflow(dmax[en]);
idpb(b, dlp[en]);
dct[en]←dct[en]+1;
end;
simp procedure AddPart(integer parttype, beginrec, nrecs, pad(0));
begin
if nparts≥maxparts then overflow(nparts);
idpb(parttype, pdptr);
idpb(beginrec, pdptr);
idpb(nrecs, pdptr);
idpb(pad, pdptr);
nparts←nparts+1;
end;
simp procedure Flush;
begin
short integer k,n;
n←dct[en]; k←n-lsc[en];
if k>0 then
begin integer i;
if k≤32 then ELByte(ELShowCharactersShort+k-1)
else begin
for i←1 upto (k div 255) do
begin ELByte(ELShowCharacters); ELByte(255); end;
ELByte(ELShowCharacters); ELByte(k mod 255);
end;
lsc[en]←n;
end;
end;
simp procedure FlushAll;
begin integer sen,i;
sen←en;
for i←0 upto 3 do
begin
en←i;
Flush;
end;
en←sen;
end;
simp procedure SetX(integer x);
begin
Flush; ELByte(ELSetX); ELWord(cx[en]←x);
DEBUGONLY if (DEBUG land precommands) then
print(nextline,indent,"SetX(",x*micastoprint,")");
end;
simp procedure SetY(integer y);
begin
y←pageheight-y # invert y direction;
comment note the assumption that ShowCharacters doesn't change y;
if y≠cy[en] then
begin Flush; ELByte(ELSetY); ELWord(cy[en]←y);
DEBUGONLY if (DEBUG land precommands) then
print(nextline,indent,"SetY(",(pageheight-y)*micastoprint,")");
end;
end;
simp procedure PutRectangle(integer xx0,yy0,h,w);
if h>0 and w>0 then
begin comment xx0,yy0 specify the upper left corner;
en←3 # put all rectangles in entity 3;
Flush;
SetX(xx0); SetY(yy0+h);
ELByte(ELShowRectangle); ELWord(w); ELWord(h);
DEBUGONLY if (DEBUG land precommands) then
print(nextline,indent,"PutRectangle(",xx0*micastoprint,",",
yy0*micastoprint,",",h*micastoprint,",",
w*micastoprint,")");
end;
simp procedure SetFont(integer f);
begin
integer t;
comment switch entities if necessary;
en←fontset(f) # the 64 fonts are interleaved into four font sets;
t←fontno(f) # font number in font set;
if cf[en]≠t then begin Flush; ELByte(ELFont+(cf[en]←t));
fontused[f]←true;
end;
DEBUGONLY if (DEBUG land precommands) then
print(nextline,indent,"SetFont(",f,")");
end;
comment append a trailer to entity list n;
simp procedure ETrailer(integer n, beginbyte, bytelength);
begin
en←n;
if ect[en]=0 then return # empty entity - leave it empty;
if (ect[en] mod 2) ≠ 0 then ELByte(ELNop) # pad to word boundary;
if (ect[en] mod 4) ≠ 0 then
begin ELByte(ELNop); ELByte(ELNop) end # pad to DWord boundary;
ELByte(125) # type;
ELByte(en) # font set;
ELDWord(beginbyte) # beginning of DL region;
ELDWord(bytelength) # length of DL region;
ELWord(0); ELWord(0) # origin (Xe, Ye);
ELWord(0); ELWord(0) # bottom left corner of bounding box;
ELWord(pagewidth); ELWord(pageheight) # dimensions of bounding box;
ELWord(ect[en] div 2+1) # entity length in WORDS (including this number);
comment Assertion: the entity now contains a multiple of four bytes;
end;
define outchar(c)={DLByte(((c)land '177))} #
macro for output of a single character;
define outrule(xx0,yy0,h,w)={PutRectangle(xx0,yy0,h,w)};
define newfont(f)={SetFont(f)};
define setpos(xx0,yy0)={SetY(yy0); SetX(xx0)};
comment General description of the shipout procedure.
The simplest imaginable pageout routine would essentially be a recursive
procedure that goes through the data structure of the given page and,
whenever coming to a character or rule node, it would cause that character or
rule to be output to the appropriate place depending on its context.
This routine would periodically issue commands to the output device,
saying "Put such-and-such a character (or rule) in such and such a place."
One should probably make use of the fact most of a DVI file
is simple text -- extra care can be taken to make the output
occur faster in simple cases.
Therefore this pageout procedure has been constructed by taking the
simple recursive scheme and augmenting it: On simple text,
most of the generality is omitted.
Since Press positions are computed in micas (1 mica = 10 microns = 1/2540 inch)
rather than in rsu's all dimensions will have to be adequately converted.
Conversion gets complicated by the fact that both particular font magnifications
and the global magnification factor must be taken into account.
The Press convention is that increasing y goes upward.
However, to avoid much error-prone
modification of the code, the y-downward convention is maintained, and y
is transformed only within the SetY procedure, assuming an 11-inch-high page.
What constitutes an "entity" in a page of TEX output is not clear. One view
would treat each TEX "box" as an entity, but this would entail an absurd amount
of overhead, since even single characters are packaged in individual boxes.
The extreme opposite view, adopted here, treats the entire page as one
very large entity. Actually, FOUR entity lists (and corresponding data lists)
are maintained, since four font sets are needed to accommodate 64 fonts.
To direct characters and commands to the proper entity requires some care.
;
comment readfontinfo;
procedure readfontinfo(integer f, fontmag) # reads font information
file for font number f, with magnification fontmag/1000 times
the font design size. Dimensions are stored as quantities
in the internal unit system of the DVI file;
begin "font information"
integer i,p,m,temp,lfl,lh,ec,bc,nw,nh,nd,ni,nl,nk,ne,np,fbt;
integer fc,lc # the first and last codes that TEX wants;
integer fbc,lec # endpoints of intersection of the range of existing codes
and the range of codes that TEX wants;
integer tfmchan;
string s;
real dsize, metricscale;
scanfilename(fontname[f]) # put components in fname;
if fname[2]=0 then
begin fname[2]←"[TEX,SYS]";
fontname[f]←fname[0]&fname[1]&fname[2] # let's play it safe;
end;
s←fname[0]&".TFM"&fname[2] # name of auxiliary font information file;
open(tfmchan←getchan,"DSK",8,19,0,0,0,eof);
lookup(tfmchan,s,eof);
if eof then error("Lookup failed on file "&s);
comment the .TFM file is available;
DEBUGONLY if (DEBUG land iooperations) then print(nextline,"Reading fontinfo[",s,"].");
temp←wordin(tfmchan); lfl←lhalf(temp); lh←rhalf(temp);
temp←wordin(tfmchan); bc←lhalf(temp); ec←rhalf(temp);
m←(lfl-lh-ec+bc-7);
if fmemptr+m≥fmemsize then overflow(fmemsize);
temp←wordin(tfmchan); nw←lhalf(temp); nh←rhalf(temp);
temp←wordin(tfmchan); nd←lhalf(temp); ni←rhalf(temp);
temp←wordin(tfmchan); nl←lhalf(temp); nk←rhalf(temp);
temp←wordin(tfmchan); ne←lhalf(temp); np←rhalf(temp);
fcksum[f]←wordin(tfmchan) # checksum;
dsize←(wordin(tfmchan)/(1 lsh 24))*rsusPerPoint # design size in rsu's;
fsize[f]←dsize*(fontmag/1000) # actual size of font in rsu's;
metricscale←fsize[f]/unitscale # conversion factor to get the internal metric
system of the file;
for i←1 upto 10 do temp←wordin(tfmchan) # throw away character coding scheme;
for i←1 upto 5 do fpfi[f,i]←wordin(tfmchan) # Parc Font Id;
fpfb[f]←(((fbt←wordin(tfmchan)) lsh -4) land '377) # Parc Face Byte;
for i←1 upto lh-18 do temp←wordin(tfmchan) # throw away rest of header;
fc←'000; lc←'177 # the range that TEX wants;
comment The font goes from [bc,ec], while TEX wants the range [fc,lc].
The following code throws away fontinfo for existing charaters
outside the TEX range, defaults fontinfo to zero for
nonexistent characters inside the TEX range, and reads in the
fontinfo for existing characters in the TEX range;
for i←bc upto fc-1 min ec do temp←wordin(tfmchan);
for i←fc upto bc-1 min lc do fontinfo[(f lsh 7)+i-fc]←0;
fbc←fc max bc;
lec←lc min ec;
arryin(tfmchan,fontinfo[(f lsh 7)+fbc-fc],(lec-fbc+1) max 0);
for i←lc+1 max bc upto ec do temp←wordin(tfmchan);
for i←ec+1 max fc upto lc do fontinfo[(f lsh 7)+i-fc]←0;
comment Now give warnings for bad cases;
if ec>lc and fbt≥0 then
error("Warning: font may contain accessible chars with illegal codes (above '177)");
p←fmemptr # the secondary tables go into fmem;
wdbase[f]←p;
htbase[f]←wdbase[f]+nw;
dpbase[f]←htbase[f]+nh;
icbase[f]←dpbase[f]+nd;
lgbase[f]←icbase[f]+ni;
krbase[f]←lgbase[f]+nl;
extbase[f]←krbase[f]+nk;
parbase[f]←extbase[f]+ne;
arryin(tfmchan,fmem[p],m);
fmemptr←fmemptr+m;
define scale(x)=
{memory[location(fmem[x]),real]←(fmem[x]/(1 lsh 24))*metricscale};
define funnyscale(x)=
{memory[location(fmem[x]),real]←(fmem[x]/(1 lsh 24))};
for i←0 upto nw-1 do scale(wdbase[f]+i);
for i←0 upto nh-1 do scale(htbase[f]+i);
for i←0 upto nd-1 do scale(dpbase[f]+i);
for i←0 upto ni-1 do scale(icbase[f]+i);
for i←0 upto nk-1 do scale(krbase[f]+i);
funnyscale(parbase[f]) # slant;
for i←1 upto np-1 do scale(parbase[f]+i);
release(tfmchan);
end "font information";
comment findpostamble, getfontnames;
procedure findpostamble # sets the global postambleptr to the byte number of the
first byte of the postamble;
begin "postamble"
label loc;
saf integer array block[0:127] # a disk block;
boolean lastblock;
integer byte;
integer i # counter;
integer procedure getprev # returns previous byte in file;
begin "get previous byte"
integer byt;
if (dvibytecnt land 3)=3 then comment need new word;
begin
if dvibytecnt≤0 then
if lastblock then comment read from previous block;
begin dvirecnum←dvirecnum-1; useti(dvichan,dvirecnum);
arryin(dvichan,block[0],128); dvibytecnt←128*4-1;
end
else error("Bad .DVI format: no info in last two blocks");
dviword←block[dvibytecnt lsh -2] lsh -4;
end;
byt←dviword land '377;
DEBUGONLY if (DEBUG land dvibytes) then print(nextline,"'",cvos(byt),"=",byt,
" BCNT=",dvibytecnt);
dviword←dviword lsh -8;
dvibytecnt←dvibytecnt-1;
return(byt);
end "get previous byte";
dpb(dvichan,point(4,memory[location(loc)],12)) #
store "dvichan" into machine-language instruction;
start_code loc: ugetf dvirecnum end # this is the machine-language instruction;
comment now dvirecnum has the record number of the next to the last record
of the .DVI file;
lastblock←true;
dvirecnum←dvirecnum-1 # last logical record in the file;
useti(dvichan,dvirecnum) # will read from it;
arryin(dvichan,block[0],128);
dvibytecnt←128*4-1;
byte←0;
while byte=0 do byte←getprev # skip filling nulls;
for i thru 4 do
begin
if byte≠223 then error("Bad .DVI format: Missing postamble");
byte←getprev
end;
while byte=223 do byte←getprev;
if byte≠1 then
error("Sorry, only version 1 DVI files accepted. Yours is version "
&(byte+"0")&".");
postambleptr←0;
for i thru 4 do postambleptr←(postambleptr rot -8) lor getprev;
postambleptr←(postambleptr rot -8) ash -4;
DEBUGONLY print(nextline,"POSTAMBLEPTR=",postambleptr);
end "postamble";
procedure getfontnames # gets the names of the fonts from the postamble of the
input .DVI file;
begin "fontnames"
integer i # a byte counter;
integer blk # number of logical record containing beginning of postamble ;
integer bite # one byte obtained from the .DVI file;
integer f # font number;
string s;
findpostamble # sets postambleptr;
blk←postambleptr div (128*4)+1;
useti(dvichan,blk);
dvibytecnt←4*128*(blk-1) # at beginning of block;
while dvibytecnt<postambleptr do getnext;
if getnext≠PST then error("Bad .DVI format: misplaced postamble");
lastpageptr←getint;
unitscale←getint; unitscale←unitscale/getint # num and denom of units ratio;
DEBUGONLY print(nextline,"Indicate units for displayed quantities:");
DEBUGONLY print(nextline,'11&"0 for DVI file internal units,");
DEBUGONLY print(nextline,'11&"1 for points,");
DEBUGONLY print(nextline,'11&"2 for rsu's,");
DEBUGONLY print(nextline,'11&"3 for micas.");
DEBUGONLY print(nextline,"Print units?");
DEBUGONLY s←inchwl;
DEBUGONLY printunits←case intscan(s,brchar) of (1/unitscale,1/rsusPerPoint,1,micasPerRSU);
DEBUGONLY micastoprint←printunits/micasPerRSU;
DEBUGONLY dvitoprint←unitscale*printunits;
DEBUGONLY print(nextline,"UNITSCALE=",unitscale);
DEBUGONLY print(nextline,"PRINTUNITS=",printunits);
DEBUGONLY print(nextline,"MICASTOPRINT=",micastoprint);
DEBUGONLY print(nextline,"DVITOPRINT=",dvitoprint);
DEBUGONLY print(nextline);
magnification←getint;
print(nextline,"Magnification (default, in DVI file="&cvf(magnification/1000)&"):");
if (s←inchwl)≠0 then magnification:=realscan(s,brchar)*1000;
getint; getint; comment maxpageheight and maxpagewidth are fixed;
DEBUGONLY print(nextline,"PAGEHEIGHT=",(foo←pageheight)," micas (",(foo←printunits*rsusPerPoint*pointsPerInch*11)," )");
DEBUGONLY print(nextline,"PAGEWIDTH=",(foo←pagewidth)," micas (",(foo←printunits*rsusPerPoint*pointsPerInch*8.5)," )");
DEBUGONLY print(nextline,"LASTPAGEPTR=",lastpageptr);
DEBUGONLY print(nextline,"MAGNIFICATION=",cvf(magnification/1000));
while (f←getint)≠-1 do
begin s←"";
if f≥nfonts then error("Bad .DVI format: font number≥64");
fcksum[f]←getint # get font checksum;
fmag[f]←getint # get font ``at'' value (relative to font design size) times 1000;
bite←getnext # number of characters in font name;
for i←1 upto bite do s←s&getnext;
fontname[f]←s;
DEBUGONLY print(nextline,"FONT #",f,"=",
fontname[f]," at ",fmag[f]/1000," (",fcksum[f],")");
end;
end "fontnames";
comment getfiles;
procedure getfiles # Reads the .DVI file name, opens the file and obtains
the names of the fonts from the postamble. Then opens a .PRE file
for output;
begin "getfiles"
integer i;
boolean firsttry;
string s;
open(dvichan←getchan,"DSK",8,19,0,150,brchar,eof);
loop begin
print("Input file=");
dvifile←inchwl; if dvifile=0 then go to end_of_dvipre;
scanfilename(dvifile); if fname[1]=0 then fname[1]←".DVI";
lookup(dvichan,dvifile←fname[0]&fname[1]&fname[2],eof);
if not eof then done;
print("Lookup failed on file ",dvifile,nextline);
end;
prefile←fname[0]&".PRE";
getfontnames;
firsttry←true;
loop begin
open(prechan←getchan,"DSK",8,0,19,0,0,eof);
print("Output file");
if firsttry then print(" ("&prefile&")=") else print("=");
if (s←inchwl) then
begin scanfilename(s); if fname[1]=0 then fname[1]←".PRE";
prefile←fname[0]&fname[1]&fname[2];
end
else if not firsttry then error("No output file");
enter(prechan,prefile,eof);
if eof then
begin print(nextline,"I can't write on file ",prefile);
release(prechan);
if firsttry then firsttry←false else error("!!");
print(nextline);
end
else done
end;
for i←0 upto nfonts-1 do fontused[i]←false;
octaltime←call(0,"ACCTIM");
prerecnum←0;
prebytecnt←0;
pdptr←point(16,partdir[0],-1);
nparts←0;
DEBUGONLY for i←0 upto 1 do begin dlmaxused[i]←elmaxused[i]←0 end;
end "getfiles";
comment The recursive procedure nestout;
recursive procedure nestout(integer x,y,xamt,wamt,yamt,zamt);
begin "nestout" comment This procedure generates instruction strings to output
the box represented by the current nest in curpage (a page of the .DVI file).
Upon entry, the upper left corner of the box is to have coordinates (x,y),
xamt and wamt contain horizontal, and yamt and zamt vertical, increments
transmitted from the calling nest. All these are quantities in the units
employed internally by the DVI file;
short integer xx0,yy0,h,w # units rounded to micas;
comment rounding from real to short integers is faster than to general integers;
boolean brokenline,brokenword;
brokenline←brokenword←true # force start of new string;
loop if (curdvibyte←getnext)<'200 then
begin "line character" integer w # font info for this character;
w←fontinfo[(curfont lsh 7) lor curdvibyte] # get info about character;
if brokenline then
begin
xx0←conv*x; yy0←conv*y # round to correct starting position;
newfont(curfont); setpos(xx0,yy0);
brokenline←false;
end
else if brokenword then
begin
xx0←conv*x # round to correct starting position;
setX(xx0);
brokenword←false;
end;
outchar(curdvibyte);
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"(",x*dvitoprint,",",y*dvitoprint,") "&curdvibyte&"@",curfont,
" →",charwd(curfont,w)*dvitoprint);
comment now compensate for the width of the character;
x←x+charwd(curfont,w);
end "line character"
else if (FONTNUM≤curdvibyte<(FONTNUM+nfonts)) then comment font declaration;
begin "font"
curdvibyte←curdvibyte-FONTNUM # get font number;
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"(FONT ",curdvibyte,")");
if curdvibyte≠curfont then comment font changed after last character;
begin
if parbase[curdvibyte]=0 then comment font not loaded;
if fontname[curdvibyte] then
readfontinfo(curdvibyte, fmag[curdvibyte])
else error("Font #"&cvs(curdvibyte)&" not declared");
brokenline←true # force declaration of font and position;
curfont←curdvibyte;
end;
end "font"
else
begin "moves"
case curdvibyte of begin "cases"
[NOP] begin "no-op"
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"NOP");
comment do nothing;
end "no-op";
[BOP][PST] error("Too many DVIPUSH in page "&cvs(curpage)
&"[Found "&(if curdvibyte=BOP then "BOP" else "PST")&"]");
[EOP] begin "end-of-page"
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"EOP");
return # to pageout;
end "end-of-page";
[DVIPUSH] begin "dvi-push" brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,(indent←indent&"."),"{X=",x*dvitoprint," Y=",y*dvitoprint,"--");
nestout(x,y,xamt,wamt,yamt,zamt)
end "dvi-push";
[DVIPOP] begin "dvi-pop"
DEBUGONLY if (DEBUG land dvicommands) then indent←indent[1 to ∞-1];
DEBUGONLY if (DEBUG land dvicommands) then print("}");
return # to previous call of nestout;
end "dvi-pop";
[DVIFONT] comment not used at the time this program is written;
begin "dvi-font"
curdvibyte←getint # get font number;
if curdvibyte≠curfont then # font changed after last character;
begin
if not brokenline then newfont(curdvibyte);
curfont←curdvibyte;
end;
end "dvi-font";
[VERTRULE] begin "vertical-rule" integer wd;
h←roundup(getint);
xx0←conv*x; yy0←conv*y;
x←x+(wd←getint); w←roundup(wd);
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"(",(x-wd)*dvitoprint,",",
y*dvitoprint,"-",
cvf(h*dvitoprint/conv),
") VRULE→",wd*dvitoprint);
outrule(xx0,yy0-h,h,w);
brokenline←true;
end "vertical-rule";
[HORZRULE] begin "horizontal-rule"
h←roundup(getint); w←roundup(getint);
yy0←conv*y; xx0:=conv*x;
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"(",x*dvitoprint,",",
y*dvitoprint,"-",
cvf(h*dvitoprint/conv),
") HRULE");
outrule(xx0,yy0-h,h,w);
brokenline←true;
end "horizontal-rule";
[HORZCHAR]
begin "horizontal-char"
xx0←conv*x; yy0←conv*y;
comment Now (xx0,yy0) is reference point (in micas)
where the character should go;
newfont(curfont);
setpos(xx0,yy0);
curdvibyte←getnext;
outchar(curdvibyte);
DEBUGONLY if (DEBUG land dvicommands) then
print(nextline,indent,"(",x*dvitoprint,",",
y*dvitoprint,") ",
"HCHAR "&curdvibyte&"@",curfont);
brokenline←true;
end "horizontal-char";
[X4] begin xamt←fourbites; x←x+xamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{X4→",xamt*dvitoprint,"}");
end;
[X3] begin xamt←threebites; x←x+xamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{X3→",xamt*dvitoprint,"}");
end;
[X2] begin xamt←twobites; x←x+xamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{X2→",xamt*dvitoprint,"}");
end;
[X0] begin x←x+xamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{X0→",xamt*dvitoprint,"}");
end;
[W4] begin wamt←fourbites; x←x+wamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{W4→",wamt*dvitoprint,"}");
end;
[W3] begin wamt←threebites; x←x+wamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{W3→",wamt*dvitoprint,"}");
end;
[W2] begin wamt←twobites; x←x+wamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{W2→",wamt*dvitoprint,"}");
end;
[W0] begin x←x+wamt; brokenword←true;
DEBUGONLY if (DEBUG land dvicommands) then print("{W0→",wamt*dvitoprint,"}");
end;
[Y4] begin yamt←fourbites; y←y+yamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Y4↓",yamt*dvitoprint);
end;
[Y3] begin yamt←threebites; y←y+yamt;brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Y3↓",yamt*dvitoprint);
end;
[Y2] begin yamt←twobites; y←y+yamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Y2↓",yamt*dvitoprint);
end;
[Y0] begin y←y+yamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Y0↓",yamt*dvitoprint);
end;
[Z4] begin zamt←fourbites; y←y+zamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Z4↓",zamt*dvitoprint);
end;
[Z3] begin zamt←threebites; y←y+zamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Z3↓",zamt*dvitoprint);
end;
[Z2] begin zamt←twobites; y←y+zamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Z2↓",zamt*dvitoprint);
end;
[Z0] begin y←y+zamt; brokenline←true;
DEBUGONLY if (DEBUG land dvicommands) then print(nextline,indent,"Z0↓",zamt*dvitoprint);
end;
else error("Undefined command in page "&cvs(curpage)
&"[Probably too many DVIPOPs]")
end "cases";
end "moves";
end "nestout";
procedure pageout # the main output procedure,produces one page;
begin
integer i,padbytes, nextrec;
while curdvibyte≠BOP do curdvibyte←getnext;
for i←"0" upto "9" do texcounter[i]←getint;
curpage←texcounter["0"];
lastpageptr←getint # use them for selective page conversion;
print("[",curpage);
StartPage;
nestout(inches(1),inches(1),0.0,0.0,0.0,0.0) # prepare table of command strings;
comment the "inches(1)" here leaves an inch of margin for cases where the user
has gone outside the box with negative glue;
comment pad data lists to multiples of 4 bytes;
for i←0 upto 3 do
begin integer curbytepos,j,numtopad;
en←i;
Flush # don't forget to flush out pending characters!;
curbytepos←dct[en] mod 4;
if curbytepos=0 then continue;
numtopad←4-curbytepos;
for j←1 upto numtopad do DLByte(0);
ELByte(ELSkipCharactersShort+numtopad-1);
end;
comment write data lists;
Sout(dl0[0], dct[0]);
Sout(dl1[0], dct[1]);
Sout(dl2[0], dct[2]);
Sout(dl3[0], dct[3]);
comment construct entity trailers;
ETrailer(0, 0, dct[0]);
ETrailer(1, dct[0], dct[1]);
ETrailer(2, dct[1]+dct[0], dct[2]);
ETrailer(3, dct[2]+dct[1]+dct[0], dct[3]);
Wout(0) # zero word to mark beginning of entity lists;
Wout(0) # and another zero word to get back on double-word boundary;
comment write entity lists;
Sout(el0[0], ect[0]);
Sout(el1[0], ect[1]);
Sout(el2[0], ect[2]);
Sout(el3[0], ect[3]);
padbytes←PadRecord(ELNop);
nextrec←prebytecnt div 512;
AddPart(0, prerecnum, nextrec-prerecnum, padbytes div 2) # want WORDS of padding;
prerecnum←nextrec;
DEBUGONLY for i←0 upto 3 do
DEBUGONLY begin
DEBUGONLY dlmaxused[i]←dlmaxused[i] max dct[i];
DEBUGONLY elmaxused[i]←elmaxused[i] max ect[i];
DEBUGONLY end;
print("]");
end;
procedure closeout # just before TEX stops, do this;
begin integer n,f;
integer nextrec, pdlen, time, i;
comment write the font directory part;
define entrylength=16 # in WORDS!!!;
for f←0 upto nfonts-1 do if (fontname[f] and fontused[f]) then
begin
integer mcsize, firstchar, lastchar;
mcsize←fsize[f]*(magnification/1000)*micasPerRSU+.5 # rounded size in micas;
Wout(entrylength);
Bout(fontset(f)) # font set;
Bout(fontno(f)) # font number within set;
firstchar←'000; lastchar←'177;
Bout(firstchar); Bout(lastchar);
comment family name is a bcpl string, max 20 bytes;
iBCPLout(f, 20);
Bout(fpfb[f]) # face;
Bout(firstchar) # "source" character;
Wout(-mcsize);
Wout(0) # rotation;
end;
Wout(0) # a zero word to mark the end of the font directory!;
PadRecord(0);
nextrec←prebytecnt div 512;
AddPart(1, prerecnum, nextrec-prerecnum);
prerecnum←nextrec;
comment write the part directory;
pdlen←8*nparts # 4 words (8 bytes) per part;
Sout(partdir[0], pdlen);
PadRecord(0);
nextrec←prebytecnt div 512;
comment now, finally, the document directory;
Wout(27183) # general password;
Wout(nextrec+1) # total number of records in file (including this one);
Wout(nparts) # number of parts;
Wout(prerecnum) # start of part dir;
Wout(nextrec-prerecnum) # number of records in part dir;
Wout(-1) # back-pointer to obsolete document directory(?);
Dout(altotime) # machine-style date/time stamp;
Wout(1); Wout(1) # first and last copy;
for i←10 upto '177 do Wout(-1);
sBCPLout(prefile, 2*26);
sBCPLout(username, 2*16) # user's name for break page of document;
sBCPLout(daytime, 2*20) # string date and time for break page as well;
PadRecord(0);
release(prechan);
ptostr(0,"dover "&prefile&"/q") # suggest file spooling to user;
end;
comment Main routine;
DEBUGONLY setprint("dvierr.tmp","B");
DEBUGONLY setformat(0,4) # four decimals is enough;
DEBUGONLY DEBUG←dvicommands+precommands+iooperations; comment ordinary debugging required;
getfiles;
useti(dvichan,1); dvibytecnt←0 # to start reading from the beginning of the file;
curfont←-1 # force font declaration;
while (curdvibyte←getnext)≠PST do pageout;
closeout # add the postamble to the .PRE file and close it;
end_of_dvipre:
release(dvichan) # close the input file;
DEBUGONLY setprint("dvierr.tmp","T");
end "DVIPRE";